home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1995 February: Tool Chest / Dev.CD Feb 95 / Dev.CD Feb 95.toast / Tool Chest / Development Tools & Languages / Macintosh Common Lisp Related / interfaces / PInterface Translator / replacements / SANE.lisp next >
Encoding:
Text File  |  1993-09-16  |  11.1 KB  |  515 lines  |  [TEXT/CCL2]
  1.  
  2. (in-package :traps)             ; 
  3. ; Created: Friday, September 15, 1989 at 5:01 PM
  4. ;     SANE.p
  5. ;     Pascal Interface to the Macintosh Libraries
  6. ; 
  7. ;     Copyright Apple Computer, Inc.    1985-1989
  8. ;     All rights reserved
  9. ; 
  10.  
  11. ; $IFC UNDEFINED UsingIncludes
  12. ; $SETC UsingIncludes := 0
  13. ; $ENDC
  14.  
  15. ; $IFC NOT UsingIncludes
  16.  
  17. ; $ENDC
  18.  
  19. ; $IFC UNDEFINED UsingSANE
  20. ; $SETC UsingSANE := 1
  21.  
  22. ; $I+
  23. ; $SETC SANEIncludes := UsingIncludes
  24. ; $SETC UsingIncludes := 1
  25. ; $SETC UsingIncludes := SANEIncludes
  26.  
  27. ;  Elems881 mode set by -d Elems881=true on Pascal command line 
  28.  
  29. ; $IFC UNDEFINED Elems881
  30. ; $SETC Elems881 = FALSE
  31. ; $ENDC
  32.  
  33. ; $IFC OPTION(MC68881)
  34.  
  35. ; *======================================================================*
  36. ;  *    The interface specific to the MC68881 SANE library    *
  37. ;  *======================================================================*
  38.  
  39. #+mc68881
  40. (progn
  41. (defconstant $Inexact 8)
  42. (defconstant $DivByZero 16)
  43. (defconstant $Underflow 32)
  44. (defconstant $Overflow 64)
  45. (defconstant $Invalid 128)
  46. (defconstant $CurInex1 256)
  47. (defconstant $CurInex2 512)
  48. (defconstant $CurDivByZero 1024)
  49. (defconstant $CurUnderflow 2048)
  50. (defconstant $CurOverflow 4096)
  51. (defconstant $CurOpError 8192)
  52. (defconstant $CurSigNaN 16384)
  53. (defconstant $CurBSonUnor 32768)
  54. )
  55.  
  56. ; $ELSEC
  57.  
  58. ; *======================================================================*
  59. ;  *    The interface specific to the software SANE library    *
  60. ;  *======================================================================*
  61.  
  62. #-mc68881
  63. (progn
  64. (defconstant $Invalid 1)
  65. (defconstant $Underflow 2)
  66. (defconstant $Overflow 4)
  67. (defconstant $DivByZero 8)
  68. (defconstant $Inexact 16)
  69. (defconstant $IEEEDefaultEnv 0) ; IEEE-default floating-point environment constant
  70. )
  71. ; $ENDC
  72.  
  73. ; *======================================================================*
  74. ;  *    The common interface for the SANE library     *
  75. ;  *======================================================================*
  76.  
  77. (defconstant $DecStrLen 255)
  78. (defconstant $SigDigLen 20)     ; for 68K; use 28 in 6502 SANE
  79.  
  80. (def-mactype :relop (find-mactype :unsigned-byte))
  81.  
  82. (def-mactype :numclass (find-mactype :unsigned-byte))
  83.  
  84. (def-mactype :rounddir (find-mactype :unsigned-byte))
  85.  
  86. (def-mactype :roundpre (find-mactype :unsigned-byte))
  87.  
  88. (def-mactype :decimalkind (find-mactype :unsigned-byte))
  89.  
  90. ; $IFC OPTION(MC68881)
  91.  
  92. ; *======================================================================*
  93. ;  *    The interface specific to the MC68881 SANE library    *
  94. ;  *======================================================================*
  95. #+mc68881
  96. (progn
  97. (def-mactype :exception (find-mactype :signed-long))
  98.  
  99. (defrecord Environment 
  100.    (FPCR :signed-long)
  101.    (FPSR :signed-long)
  102.    )
  103.  
  104. (def-mactype :extended80 (find-mactype :array))
  105.  
  106. (defrecord TrapVector 
  107.    (Unordered :signed-long)
  108.    (Inexact :signed-long)
  109.    (DivByZero :signed-long)
  110.    (Underflow :signed-long)
  111.    (OpError :signed-long)
  112.    (Overflow :signed-long)
  113.    (SigNaN :signed-long)
  114.    )
  115. )
  116.  
  117. ; $ELSEC
  118.  
  119. ; *======================================================================*
  120. ; *  The interface specific to the software SANE library      *
  121. ; *======================================================================*
  122. #+mc68881
  123. (progn
  124. (def-mactype :exception (find-mactype :signed-integer))
  125.  
  126. (def-mactype :environment (find-mactype :signed-integer))
  127.  
  128. (def-mactype :extended96 (find-mactype :array))
  129.  
  130. (defrecord MiscHaltInfo 
  131.    (HaltExceptions :signed-integer)
  132.    (PendingCCR :signed-integer)
  133.    (PendingD0 :signed-long)
  134.    )
  135. )
  136. ; $ENDC
  137.  
  138. ; *======================================================================*
  139. ; *  The common interface for the SANE library    *
  140. ; *======================================================================*
  141.  
  142. (def-mactype :decstr (find-mactype :string))
  143.  
  144. (defrecord DecForm 
  145.   (filler1 :signed-byte)
  146.    (style :unsigned-byte)
  147.    (digits :signed-integer)
  148.    )
  149.  
  150. (defrecord Decimal
  151.   (filler1 :signed-byte)
  152.    (sgn :unsigned-byte)
  153.    (exp :signed-integer)
  154.    (sig (:string #$sigdiglen))
  155.    )
  156.  
  157. (def-mactype :cstrptr (find-mactype :pointer))
  158.  
  159. ; $IFC OPTION(MC68881)
  160.  
  161. ;  return IEEE default environment 
  162.  
  163. #| Not in ROM
  164. (deftrap _ieeedefaultenv nil
  165.    (:stack :signed-integer)
  166.    (:stack-trap #x0))
  167. |#
  168. #| Not in ROM
  169. (deftrap _settrapvector ((traps :trapvector))
  170.    nil
  171.    (:stack-trap #x0))
  172. |#
  173. #| Not in ROM
  174. (deftrap _gettrapvector ((traps (:pointer :trapvector)))
  175.    nil
  176.    (:stack-trap #x0))
  177. |#
  178. #| Not in ROM
  179. (deftrap _x96tox80 ((x extended))
  180.    (:stack (:array :signed-integer 5))
  181.    (:stack-trap #x0))
  182. |#
  183. #| Not in ROM
  184. (deftrap _x80tox96 ((x (:array :signed-integer 5)))
  185.    (:stack extended)
  186.    (:stack-trap #x0))
  187. |#
  188. #| Not in ROM
  189. (deftrap _sin ((x extended))
  190.    (:stack extended)
  191.    (:stack-trap #x0))
  192. |#
  193. #| Not in ROM
  194. (deftrap _cos ((x extended))
  195.    (:stack extended)
  196.    (:stack-trap #x0))
  197. |#
  198. #| Not in ROM
  199. (deftrap _arctan ((x extended))
  200.    (:stack extended)
  201.    (:stack-trap #x0))
  202. |#
  203. #| Not in ROM
  204. (deftrap _exp ((x extended))
  205.    (:stack extended)
  206.    (:stack-trap #x0))
  207. |#
  208. #| Not in ROM
  209. (deftrap _ln ((x extended))
  210.    (:stack extended)
  211.    (:stack-trap #x0))
  212. |#
  213. #| Not in ROM
  214. (deftrap _log2 ((x extended))
  215.    (:stack extended)
  216.    (:stack-trap #x0))
  217. |#
  218. #| Not in ROM
  219. (deftrap _ln1 ((x extended))
  220.    (:stack extended)
  221.    (:stack-trap #x0))
  222. |#
  223. #| Not in ROM
  224. (deftrap _exp2 ((x extended))
  225.    (:stack extended)
  226.    (:stack-trap #x0))
  227. |#
  228. #| Not in ROM
  229. (deftrap _exp1 ((x extended))
  230.    (:stack extended)
  231.    (:stack-trap #x0))
  232. |#
  233. #| Not in ROM
  234. (deftrap _tan ((x extended))
  235.    (:stack extended)
  236.    (:stack-trap #x0))
  237. |#
  238. #| Not in ROM
  239. (deftrap _gethaltvector nil
  240.    (:stack :signed-long)
  241.    (:stack-trap #x0))
  242. |#
  243. #| Not in ROM
  244. (deftrap _sethaltvector ((v :signed-long))
  245.    nil
  246.    (:stack-trap #x0))
  247. |#
  248. #| Not in ROM
  249. (deftrap _x96tox80 ((x (:array :signed-integer 6)))
  250.    (:stack extended)
  251.    (:stack-trap #x0))
  252. |#
  253. #| Not in ROM
  254. (deftrap _x80tox96 ((x extended))
  255.    (:stack (:array :signed-integer 6))
  256.    (:stack-trap #x0))
  257. |#
  258. #| Not in ROM
  259. (deftrap _log2 ((x extended))
  260.    (:stack extended)
  261.    (:stack-trap #x0))
  262. |#
  263. #| Not in ROM
  264. (deftrap _ln1 ((x extended))
  265.    (:stack extended)
  266.    (:stack-trap #x0))
  267. |#
  268. #| Not in ROM
  269. (deftrap _exp2 ((x extended))
  270.    (:stack extended)
  271.    (:stack-trap #x0))
  272. |#
  273. #| Not in ROM
  274. (deftrap _exp1 ((x extended))
  275.    (:stack extended)
  276.    (:stack-trap #x0))
  277. |#
  278. #| Not in ROM
  279. (deftrap _tan ((x extended))
  280.    (:stack extended)
  281.    (:stack-trap #x0))
  282. |#
  283. #| Not in ROM
  284. (deftrap _num2integer ((x extended))
  285.    (:stack :signed-integer)
  286.    (:stack-trap #x0))
  287. |#
  288. #| Not in ROM
  289. (deftrap _num2longint ((x extended))
  290.    (:stack :signed-long)
  291.    (:stack-trap #x0))
  292. |#
  293. #| Not in ROM
  294. (deftrap _num2real ((x extended))
  295.    (:stack real)
  296.    (:stack-trap #x0))
  297. |#
  298. #| Not in ROM
  299. (deftrap _num2double ((x extended))
  300.    (:stack double)
  301.    (:stack-trap #x0))
  302. |#
  303. #| Not in ROM
  304. (deftrap _num2extended ((x extended))
  305.    (:stack extended)
  306.    (:stack-trap #x0))
  307. |#
  308. #| Not in ROM
  309. (deftrap _num2comp ((x extended))
  310.    (:stack :comp)
  311.    (:stack-trap #x0))
  312. |#
  313. #| Not in ROM
  314. (deftrap _num2dec ((f :decform) (x extended) (d (:pointer :decimal)))
  315.    nil
  316.    (:stack-trap #x0))
  317. |#
  318. #| Not in ROM
  319. (deftrap _dec2num ((d :decimal))
  320.    (:stack extended)
  321.    (:stack-trap #x0))
  322. |#
  323. #| Not in ROM
  324. (deftrap _num2str ((f :decform) (x extended) (s (:pointer (:string decstrlen))))
  325.    nil
  326.    (:stack-trap #x0))
  327. |#
  328. #| Not in ROM
  329. (deftrap _str2num ((s (:string decstrlen)))
  330.    (:stack extended)
  331.    (:stack-trap #x0))
  332. |#
  333. #| Not in ROM
  334. (deftrap _str2dec ((s (:string decstrlen)) (index (:pointer :signed-integer)) (d (:pointer :decimal)) (validprefix (:pointer :boolean)))
  335.    nil
  336.    (:stack-trap #x0))
  337. |#
  338. #| Not in ROM
  339. (deftrap _cstr2dec ((s (:pointer :character)) (index (:pointer :signed-integer)) (d (:pointer :decimal)) (validprefix (:pointer :boolean)))
  340.    nil
  341.    (:stack-trap #x0))
  342. |#
  343. #| Not in ROM
  344. (deftrap _dec2str ((f :decform) (d :decimal) (s (:pointer (:string decstrlen))))
  345.    nil
  346.    (:stack-trap #x0))
  347. |#
  348. #| Not in ROM
  349. (deftrap _remainder ((x extended) (y extended) (quo (:pointer :signed-integer)))
  350.    (:stack extended)
  351.    (:stack-trap #x0))
  352. |#
  353. #| Not in ROM
  354. (deftrap _rint ((x extended))
  355.    (:stack extended)
  356.    (:stack-trap #x0))
  357. |#
  358. #| Not in ROM
  359. (deftrap _scalb ((n :signed-integer) (x extended))
  360.    (:stack extended)
  361.    (:stack-trap #x0))
  362. |#
  363. #| Not in ROM
  364. (deftrap _logb ((x extended))
  365.    (:stack extended)
  366.    (:stack-trap #x0))
  367. |#
  368. #| Not in ROM
  369. (deftrap _copysign ((x extended) (y extended))
  370.    (:stack extended)
  371.    (:stack-trap #x0))
  372. |#
  373. #| Not in ROM
  374. (deftrap _nextreal ((x real) (y real))
  375.    (:stack real)
  376.    (:stack-trap #x0))
  377. |#
  378. #| Not in ROM
  379. (deftrap _nextdouble ((x double) (y double))
  380.    (:stack double)
  381.    (:stack-trap #x0))
  382. |#
  383. #| Not in ROM
  384. (deftrap _nextextended ((x extended) (y extended))
  385.    (:stack extended)
  386.    (:stack-trap #x0))
  387. |#
  388. #| Not in ROM
  389. (deftrap _xpwri ((x extended) (i :signed-integer))
  390.    (:stack extended)
  391.    (:stack-trap #x0))
  392. |#
  393. #| Not in ROM
  394. (deftrap _xpwry ((x extended) (y extended))
  395.    (:stack extended)
  396.    (:stack-trap #x0))
  397. |#
  398. #| Not in ROM
  399. (deftrap _compound ((r extended) (n extended))
  400.    (:stack extended)
  401.    (:stack-trap #x0))
  402. |#
  403. #| Not in ROM
  404. (deftrap _annuity ((r extended) (n extended))
  405.    (:stack extended)
  406.    (:stack-trap #x0))
  407. |#
  408. #| Not in ROM
  409. (deftrap _randomx ((x (:pointer extended)))
  410.    (:stack extended)
  411.    (:stack-trap #x0))
  412. |#
  413. #| Not in ROM
  414. (deftrap _classreal ((x real))
  415.    (:stack :unsigned-byte)
  416.    (:stack-trap #x0))
  417. |#
  418. #| Not in ROM
  419. (deftrap _classdouble ((x double))
  420.    (:stack :unsigned-byte)
  421.    (:stack-trap #x0))
  422. |#
  423. #| Not in ROM
  424. (deftrap _classcomp ((x :comp))
  425.    (:stack :unsigned-byte)
  426.    (:stack-trap #x0))
  427. |#
  428. #| Not in ROM
  429. (deftrap _classextended ((x extended))
  430.    (:stack :unsigned-byte)
  431.    (:stack-trap #x0))
  432. |#
  433. #| Not in ROM
  434. (deftrap _signnum ((x extended))
  435.    (:stack :signed-integer)
  436.    (:stack-trap #x0))
  437. |#
  438. #| Not in ROM
  439. (deftrap _nan ((i :signed-integer))
  440.    (:stack extended)
  441.    (:stack-trap #x0))
  442. |#
  443. #| Not in ROM
  444. (deftrap _setexception ((e :signed-integer) (b :boolean))
  445.    nil
  446.    (:stack-trap #x0))
  447. |#
  448. #| Not in ROM
  449. (deftrap _testexception ((e :signed-integer))
  450.    (:stack :boolean)
  451.    (:stack-trap #x0))
  452. |#
  453. #| Not in ROM
  454. (deftrap _sethalt ((e :signed-integer) (b :boolean))
  455.    nil
  456.    (:stack-trap #x0))
  457. |#
  458. #| Not in ROM
  459. (deftrap _testhalt ((e :signed-integer))
  460.    (:stack :boolean)
  461.    (:stack-trap #x0))
  462. |#
  463. #| Not in ROM
  464. (deftrap _setround ((r :unsigned-byte))
  465.    nil
  466.    (:stack-trap #x0))
  467. |#
  468. #| Not in ROM
  469. (deftrap _getround nil
  470.    (:stack :unsigned-byte)
  471.    (:stack-trap #x0))
  472. |#
  473. #| Not in ROM
  474. (deftrap _setprecision ((p :unsigned-byte))
  475.    nil
  476.    (:stack-trap #x0))
  477. |#
  478. #| Not in ROM
  479. (deftrap _getprecision nil
  480.    (:stack :unsigned-byte)
  481.    (:stack-trap #x0))
  482. |#
  483. #| Not in ROM
  484. (deftrap _setenvironment ((e :signed-integer))
  485.    nil
  486.    (:stack-trap #x0))
  487. |#
  488. #| Not in ROM
  489. (deftrap _getenvironment ((e (:pointer :signed-integer)))
  490.    nil
  491.    (:stack-trap #x0))
  492. |#
  493. #| Not in ROM
  494. (deftrap _procentry ((e (:pointer :signed-integer)))
  495.    nil
  496.    (:stack-trap #x0))
  497. |#
  498. #| Not in ROM
  499. (deftrap _procexit ((e :signed-integer))
  500.    nil
  501.    (:stack-trap #x0))
  502. |#
  503. #| Not in ROM
  504. (deftrap _relation ((x extended) (y extended))
  505.    (:stack :unsigned-byte)
  506.    (:stack-trap #x0))
  507. |#
  508. ; $ENDC
  509.  
  510.  
  511. (export '($sigdiglen $decstrlen $ieeedefaultenv $inexact $divbyzero $overflow
  512.           $underflow $invalid $curbsonunor $cursignan $curoperror $curoverflow
  513.           $curunderflow $curdivbyzero $curinex2 $curinex1 $invalid $overflow
  514.           $underflow $divbyzero $inexact))
  515. (provide-interface 'SANE)